Delitos en época de COVID19

Row

Tabla de incidencia

Delitos Incidencia en 2019 Incidencia en 2020 Porcentaje de cambio
Acoso sexual 4204 5597 24%
Otros delitos que atentan contra la libertad y la seguridad sexual 6325 8032 22%
Violación equiparada 3674 4225 14%
Violencia familiar 210158 220039 4%
Trata de personas 544 550 2%
Feminicidio 943 939 0%
Homicidio 29456 28808 -2%
Abuso sexual 23625 22379 -6%
Hostigamiento sexual 1860 1753 -6%
Violación simple 13656 12320 -10%
Lesiones 166440 144280 -16%
Tráfico de menores 29 21 -38%
Secuestro 1331 826 -62%

Delitos sexuales y de género

Delitos contra la libertad

Row

Delitos dolosos

Delitos violencia familiar

Mapa nacional 1 y pruebas realizadas

Row

Mapa nacional de resultados positivos

Row

Pruebas realizadas por estado

Pruebas realizadas por estado

ENTIDAD_FEDERATIVA Numero de pruebas
AGUASCALIENTES 78701
BAJA CALIFORNIA 100886
BAJA CALIFORNIA SUR 84877
CAMPECHE 29332
CHIAPAS 31468
CHIHUAHUA 90517
CIUDAD DE MÉXICO 2120540
COAHUILA DE ZARAGOZA 158380
COLIMA 23454
DURANGO 76661
GUANAJUATO 280892
GUERRERO 80064
HIDALGO 69065
JALISCO 186599
MÉXICO 665890
MICHOACÁN DE OCAMPO 112956
MORELOS 137719
NAYARIT 23405
NUEVO LEÓN 268354
OAXACA 68916
PUEBLA 175398
QUERÉTARO 131173
QUINTANA ROO 47791
SAN LUIS POTOSÍ 154689
SINALOA 80554
SONORA 120001
TABASCO 192357
TAMAULIPAS 137771
TLAXCALA 60014
VERACRUZ DE IGNACIO DE LA LLAVE 118747
YUCATÁN 91326
ZACATECAS 59188

Mapa porcentaje de positividad

Row

Porcentaje total

Row

Porcentaje 2020

Porcentaje 2021

Vacunación en LATAM

Row

Escenario general

Temporalidad (Mensual)

Temporalidad (semanal por mes)

Row

Pronósticos

---
title: "COVID19 Dashboard"
output: 
  flexdashboard::flex_dashboard:
    orientation: rows
    vertical_layout: fill
    social: [ "twitter", "facebook", "menu"]
    source_code: embed
---

```{r setup, include=FALSE}
library(flexdashboard)
# library(knitr)

#integrar visualización
library(patchwork)

library(DT)
library(rpivotTable)
library(ggplot2)
library(plotly)
library(dplyr)
library(openintro)
library(highcharter)
library(ggvis)
library(tidyverse)
# library(tibbletime)
library(reactable)
library(htmltools)
library(fpp3)
library(feasts)
library(fable)
library(tsibble)
library(lubridate)
library(kableExtra)
library(formattable)
#importación y lectura
library(readxl)
library(tidyr)
library(vroom)
#Mapas
library(leaflet)
library(ggmap) # -> para obtener lon y lat de los municipios
library(raster)
library(spData)
library(tmap)
library(RJSONIO)
library(tmaptools)
library(Hmisc)
library(mxmaps) #se instala con un repo de gitgub con el 
                #siguiente comando
                #if (!require("devtools")) {
#     install.packages("devtools")
# }
# devtools::install_github("diegovalle/mxmaps")

library(sf)
library(scales) # needed for comma
library(rgeos)
library(maptools)
library(leaflet)
library(geojsonio)
library(jsonlite)

```


```{r}

data <- read_csv("VehicleFailure.csv")
  
delitos <- read_csv("../Delitos/delitos2015-2021.csv", 
                    locale(encoding = "latin1"),
                    col_names = TRUE, 
                    col_types = NULL
                 )
  #######Quedarse solo con las columnas y filas necesarias#######

delitos_a_comparar <- c("Feminicidio", "Abuso sexual", 
                        "Acoso sexual", "Hostigamiento sexual",
                        "Otros delitos que atentan contra la libertad y la seguridad sexual",
                        "Violación simple", "Violación equiparada", "Trata de personas",
                        "Tráfico de menores", "Secuestro", "Violencia familiar")

delitos_tidy <- delitos %>%
  filter( Tipo_de_delito %in% delitos_a_comparar | 
          Subtipo_de_delito == "Homicidio doloso" |
          Subtipo_de_delito == "Lesiones dolosas" ) %>% 
  pivot_longer(
  cols = Enero:Diciembre ,
  names_to = "Meses",
  values_to = "Cuenta"
) %>% 
  group_by(Ano, Meses, Tipo_de_delito, Subtipo_de_delito) %>% 
  summarise(Cuenta = sum(Cuenta), .groups = "drop")

delitos_tidy <- delitos_tidy %>% 
  mutate(
    Meses = str_trunc(Meses, width = 3, ellipsis = ""),
    Meses = case_when(
      Meses == "Ene" ~ "Jan",
      Meses == "Abr" ~ "Apr",
      Meses == "Ago" ~ "Aug",
      Meses == "Dic" ~ "Dec",
      TRUE           ~ Meses
    )
  ) %>% 
  unite(col = "Fecha", c(Ano,Meses), sep = " ") %>% 
  mutate(Fecha = yearmonth(Fecha))

delitos_tidy_tsbl <- delitos_tidy %>% 
  as_tsibble(
    index = Fecha,
    key   = c(Tipo_de_delito, Subtipo_de_delito)
  )

mycolors <- c("blue", "#FFC125", "darkgreen", "darkorange")
```

Delitos en época de COVID19
=====================================



























































Row
-------------------------------

### Tabla de incidencia

```{r}


#Tabla de incidencia

Incidencia_2019 <-delitos_tidy_tsbl %>% 
  tsibble::group_by_key() %>% 
  tsibble::index_by(Año = year(Fecha)) %>% 
  dplyr::summarise(Cuenta = sum(Cuenta)) %>% 
  dplyr::filter(Año %in% 2019) %>%
  dplyr::as_tibble(Incidencia_2019) %>%
  dplyr::transmute( Delito = Tipo_de_delito, 
                    Incidencia_2019 = Cuenta) 

Incidencia_2020 <- delitos_tidy_tsbl %>%
  group_by_key() %>%
  
  index_by(Año = year(Fecha)) %>%
  
  dplyr::summarise(Cuenta = sum(Cuenta)) %>%
  dplyr::filter(Año %in% 2020) %>%
  dplyr::as_tibble(Incidencia_2020) %>%
  dplyr::mutate(Delito = Tipo_de_delito,
        Incidencia_2020 = Cuenta) %>%
  dplyr::select(Delito, Incidencia_2020)

Incidencia <- Incidencia_2020 %>%
  add_column(Incidencia_2019$Incidencia_2019) %>%
  dplyr::mutate(
    Porcentaje_de_cambio = round((
      (Incidencia_2020 - Incidencia_2019$Incidencia_2019)/Incidencia_2020), digits = 5),
    Incidencia_2019 = Incidencia_2019$Incidencia_2019) %>%
  
  dplyr::select(Delito, Incidencia_2019, Incidencia_2020, Porcentaje_de_cambio)%>%
  arrange(desc(Porcentaje_de_cambio)) 
 
Tabla <- Incidencia %>%
  mutate(Porcentaje_de_cambio =  percent(Porcentaje_de_cambio, 2)) %>%
  kbl(fortmat = "htlm", col.names = c("Delitos",
                                      "Incidencia en 2019",
                                      "Incidencia en 2020",
                                      "Porcentaje de cambio")) %>%
  
  kable_styling(bootstrap_options = "striped",
                full_width = F,
                position = "left",
                font_size = 14) %>%
  
  column_spec(4,color = ifelse( Incidencia$Porcentaje_de_cambio > 0, "red", "green"))
Tabla


```


### Delitos sexuales y de género

```{r}

sexuales_y_genero = c("Abuso sexual", 
                      "Acoso sexual",
                      "Feminicidio", 
                      "Violación simple", 
                      "Violación equiparada", 
                      "Hostigamiento sexual", 
                      "Otros delitos que atentan contra la libertad y la seguridad sexual")

p2 <-  delitos_tidy_tsbl %>%
  filter (Tipo_de_delito %in% sexuales_y_genero) %>%
  ggplot() + 
  geom_line(mapping = aes(x = Fecha, y = Cuenta, color = Tipo_de_delito))

p2

```

### Delitos contra la libertad

```{r}
p3 <- delitos_tidy_tsbl %>%
  filter (Tipo_de_delito %in% c("Trata de personas", "Tráfico de menores", "Secuestro") ) %>%
  ggplot() + 
  geom_line(mapping = aes(x = Fecha, y = Cuenta, color = Tipo_de_delito))

p3
```

Row
------------------------------------
### Delitos dolosos 

```{r}
p4 <- delitos_tidy_tsbl %>%
  filter(Subtipo_de_delito %in% c("Lesiones dolosas", "Homicidio doloso")) %>%
  ggplot() + 
  geom_line(mapping = aes(x = Fecha, y = Cuenta, color = Tipo_de_delito))

p4
```

### Delitos violencia familiar 

```{r}
p5 <- delitos_tidy_tsbl %>%
  filter (Tipo_de_delito == "Violencia familiar") %>%
  ggplot() +
  geom_line(mapping = aes(x = Fecha, y = Cuenta, color = Tipo_de_delito))

p5
```

Mapa nacional 1 y pruebas realizadas
========================================

Row
------------------------------------

### Mapa nacional de resultados positivos 

```{r}
# car <- data %>%
#          group_by(State) %>%
#          summarize(total = n())
# car$State <- abbr2state(car$State)
# 
# highchart() %>%
#          hc_title(text = "Car Failures in US") %>%
#          hc_subtitle(text = "Source: Vehiclefailure.csv") %>%
#          hc_add_series_map(usgeojson, car,
#                            name = "State",
#                            value = "total",
#                            joinBy = c("woename", "State")) %>%

#          hc_mapNavigation(enabled = T)
# lubridate::today()-1
# fecha <- "210415"
options(timeout = 700)
temp <- tempfile()
download.file("http://datosabiertos.salud.gob.mx/gobmx/salud/datos_abiertos/datos_abiertos_covid19.zip", temp)


Datosmex2502 <- vroom::vroom(unz(temp, unzip(temp, list = TRUE) %>% pull(Name)))
unlink(temp)

```


```{r}

Entidades <- read_xlsx("../Datos nacionales abiertos/201128 Catalogos.xlsx",sheet="Catálogo de ENTIDADES")

# Clasificación de datos  -------------------------------------------------

#datos necesarios para la prueba
datosimportates <- dplyr::select(Datosmex2502,`FECHA_INGRESO`,`ENTIDAD_RES`,
                                 `TOMA_MUESTRA_LAB`,`RESULTADO_LAB`, `TOMA_MUESTRA_ANTIGENO`,
                                 `RESULTADO_ANTIGENO`, `CLASIFICACION_FINAL`)%>%
  left_join(Entidades, by=c("ENTIDAD_RES"="CLAVE_ENTIDAD"))

#datos confirmados sin realización de pruebas
confirmados <- datosimportates %>% 
  filter(`CLASIFICACION_FINAL`%in% c(1,2,3)) %>% 
  dplyr::select(`FECHA_INGRESO`, `ENTIDAD_RES`, `ENTIDAD_FEDERATIVA`, `ABREVIATURA`) %>% 
  mutate(
    year = lubridate::year(FECHA_INGRESO),
    month = lubridate::month(FECHA_INGRESO),
    day = lubridate::day(FECHA_INGRESO)
  ) %>% 
  drop_na(`ENTIDAD_FEDERATIVA`, `FECHA_INGRESO`) 

# Agrupación de datos  ----------------------------------------------------
#Numero de positivos por estado
positivosestado <- confirmados %>%
  group_by(`ENTIDAD_RES`) %>%
  summarise(
    count=n(),
  )

#Selección de nombre estados, por orden de codigo
nombreEstado <- Entidades %>%
  dplyr::select(`ENTIDAD_FEDERATIVA`) %>%
  slice( 1:32)

mapaPositivos <- positivosestado %>%
  add_column(nombreEstado)

# Mapa  -------------------------------------------------------------------

# data(mapaPositivos)
# mapaPositivos$rand <- mapaPositivos$count
# mapaPositivos$region <- mapaPositivos$ENTIDAD_RES
# mxstate_choropleth(mapaPositivos,
#                    title = "Casos confirmados de COVID por estado.",
#                    legend = "Número de casos.",
# )


# Convert the topoJSON to spatial object
tmpdir <- tempdir()
# have to use RJSONIO or else the topojson isn't valid
write(RJSONIO::toJSON(mxstate.topoJSON), file.path(tmpdir, "sta.topojson"))
mxstate <- topojson_read(file.path(tmpdir, "sta.topojson")) 


#ordenamos los datos del topoJSON en orden numérico
mxstate <- mxstate[order(mxstate$id),]


mxstate <- as_Spatial(mxstate)

mxstate$rand <- mapaPositivos$count

bins <- c(5000,20000 , 30000, 35000, 50000, 60000, 115000,300000, Inf)
pal <- colorBin("YlOrRd", domain = mxstate$rand, bins=bins)


etiqueta <- paste(
  "Estado: ", mapaPositivos$ENTIDAD_FEDERATIVA, "
", "Número de casos: ", mapaPositivos$count ) %>% lapply(htmltools::HTML) leaflet(mxstate) %>% addPolygons( fillColor = ~pal(mxstate$rand), fillOpacity = 1, stroke = TRUE, color = "White", weight = 1.5, dashArray = "3", highlight = highlightOptions( weight = 5, color = "#666", dashArray = "", fillOpacity = 0.7, bringToFront = TRUE), label = etiqueta, )%>% addLegend(pal = pal, values = ~mapaPositivos$rand, opacity = 0.7, title = "Casos
positivos
contagios", position = "bottomright")%>% addTiles() %>% addMarkers(50, 50) %>% addControl("Positivos totales COVID19 México", position = "bottomleft") %>% addProviderTiles("CartoDB.Positron") ``` Row ------------------------------------ ### Pruebas realizadas por estado ```{r} # # Importación de datos ---------------------------------------------------- # # # # Datosmex2502 <- read_csv("210225COVID19MEXICO.csv") # # Descarga de datos desde la página web # fecha <- "210412" # options(timeout = 600) # temp <- tempfile() # download.file("http://datosabiertos.salud.gob.mx/gobmx/salud/datos_abiertos/datos_abiertos_covid19.zip", temp) # # # Datosmex2502 <- vroom::vroom(unz(temp, paste0(fecha,"COVID19MEXICO.csv"))) # unlink(temp) # # # Entidades <- read_xlsx("Datos nacionales abiertos/201128 Catalogos.xlsx",sheet="Catálogo de ENTIDADES") # # Clásificación ---------------------------------------------------------- # # #datos necesarios para la prueba # datosimportates <- dplyr::select(Datosmex2502,`FECHA_INGRESO`,`ENTIDAD_RES`, # `TOMA_MUESTRA_LAB`,`RESULTADO_LAB`, `TOMA_MUESTRA_ANTIGENO`, # `RESULTADO_ANTIGENO`, `CLASIFICACION_FINAL`)%>% # left_join(Entidades, by=c("ENTIDAD_RES"="CLAVE_ENTIDAD")) #datos de las pruebas realizadas ese día en todo el país pruebasfiltro <- datosimportates %>% dplyr::filter(`TOMA_MUESTRA_LAB`== 1 | `TOMA_MUESTRA_ANTIGENO`==1 ) %>% dplyr::select(`FECHA_INGRESO`, `ENTIDAD_RES`,`ENTIDAD_FEDERATIVA`,`ABREVIATURA`) %>% mutate( year = lubridate::year(FECHA_INGRESO), month = lubridate::month(FECHA_INGRESO), day = lubridate::day(FECHA_INGRESO) ) %>% drop_na(`ENTIDAD_FEDERATIVA`, `FECHA_INGRESO`) # Agrupación de datos ---------------------------------------------------- #Numero de pruebas por estado totales hasta la fecha de datos pruebasXEstado <- pruebasfiltro %>% group_by(`ENTIDAD_FEDERATIVA`) %>% mutate(`Numero de pruebas`=n()) %>% distinct(`ENTIDAD_FEDERATIVA`, .keep_all = TRUE) %>% arrange(`ENTIDAD_FEDERATIVA`) %>% drop_na(`ENTIDAD_FEDERATIVA`) pruebasXEstado <- pruebasXEstado %>% dplyr::select( `ENTIDAD_FEDERATIVA`, `Numero de pruebas` ) pruebasfiltro$FECHA_INGRESO <- format(pruebasfiltro$FECHA_INGRESO, "%Y-%m") #Numero de pruebas por estado según el día pruebasxEstadoxDia <- pruebasfiltro %>% group_by(`ENTIDAD_RES`, `FECHA_INGRESO`) %>% mutate(count=n()) %>% distinct(`ENTIDAD_RES`, .keep_all = TRUE) %>% arrange(`ENTIDAD_RES`) %>% drop_na(`ENTIDAD_FEDERATIVA`) # Gráfica ---------------------------------------------------------------- ggplot(data = pruebasfiltro) + geom_bar(mapping = aes(y = FECHA_INGRESO, fill = ABREVIATURA), position = "dodge") ``` ### Pruebas realizadas por estado ```{r} # Tabla ------------------------------------------------------------------ #Tabla que muestra el número de pruebas que se hacen por día en los estados formattable(pruebasXEstado, #llamo datos align =c("l","c"), #Para alinear los datos de la tabla cada "" es una columna list(`ENTIDAD_FEDERATIVA` = formatter( #datos específicos "span", style = ~ style(color = "grey",font.weight = "bold")), `Numero de pruebas` = color_bar("Red") # me crea una barra roja con proporción a los datos ) ) ``` Mapa porcentaje de positividad ======================================== Row ------------------------------------ ### Porcentaje total ```{r} # Importación de datos ---------------------------------------------------- #Datosmex2502 <- read_csv("210225COVID19MEXICO.csv") # Descarga de datos desde la página web # fecha <- "210414" # options(timeout = 700) # temp <- tempfile() # download.file("http://datosabiertos.salud.gob.mx/gobmx/salud/datos_abiertos/datos_abiertos_covid19.zip", temp) # # # Datosmex2502 <- vroom::vroom(unz(temp, unzip(temp, list = TRUE) %>% pull(Name))) # unlink(temp) # # # Entidades <- read_xlsx("Datos nacionales abiertos/201128 Catalogos.xlsx",sheet="Catálogo de ENTIDADES") # # # Clasificación de datos ------------------------------------------------- # # #datos necesarios para la prueba # datosimportates <- dplyr::select(Datosmex2502,`FECHA_INGRESO`,`ENTIDAD_RES`, # `TOMA_MUESTRA_LAB`,`RESULTADO_LAB`, `TOMA_MUESTRA_ANTIGENO`, # `RESULTADO_ANTIGENO`, `CLASIFICACION_FINAL`)%>% # left_join(Entidades, by=c("ENTIDAD_RES"="CLAVE_ENTIDAD")) # # # # #datos confirmados sin realización de pruebas # confirmados <- datosimportates %>% # filter(`CLASIFICACION_FINAL`%in% c(1,2,3)) %>% # dplyr::select(`FECHA_INGRESO`, `ENTIDAD_RES`, `ENTIDAD_FEDERATIVA`, `ABREVIATURA`) %>% # mutate( # year = lubridate::year(FECHA_INGRESO), # month = lubridate::month(FECHA_INGRESO), # day = lubridate::day(FECHA_INGRESO) # ) %>% # drop_na(`ENTIDAD_FEDERATIVA`, `FECHA_INGRESO`) #datos de las pruebas realizadas ese día en todo el país pruebasfiltro <- datosimportates %>% dplyr::filter(`TOMA_MUESTRA_LAB`== 1 | `TOMA_MUESTRA_ANTIGENO`==1 ) %>% dplyr::select(`FECHA_INGRESO`, `ENTIDAD_RES`,`ENTIDAD_FEDERATIVA`,`ABREVIATURA`) %>% mutate( year = lubridate::year(FECHA_INGRESO), month = lubridate::month(FECHA_INGRESO), day = lubridate::day(FECHA_INGRESO) ) %>% drop_na(`ENTIDAD_FEDERATIVA`, `FECHA_INGRESO`) #Separación de datos por fechas para mapas pruebas2020 <- dplyr::filter(pruebasfiltro, year==2020) pruebEstado2020 <- pruebas2020 %>% group_by(`ENTIDAD_RES`) %>% summarise( count=n() ) pruebas2021 <- dplyr::filter(pruebasfiltro, year==2021) pruebEstado2021 <- pruebas2021 %>% group_by(`ENTIDAD_RES`) %>% summarise( count=n() ) #confirmados por año para mapas confirm2020 <- confirmados %>% dplyr::filter( year==2020) %>% drop_na(`ENTIDAD_FEDERATIVA`) confirmEstado2020 <- confirm2020 %>% group_by(`ENTIDAD_RES`) %>% summarise( count=n() ) confirm2021 <- confirmados %>% dplyr::filter( year==2021) %>% drop_na(`ENTIDAD_FEDERATIVA`) confirmEstado2021 <- confirm2021 %>% group_by(`ENTIDAD_RES`) %>% summarise( count=n() ) #Numero de pruebas por estado totales hasta la fecha de datos pruebasXEstado <- pruebasfiltro %>% group_by(`ENTIDAD_RES`) %>% mutate(PRUEBAS=n()) %>% distinct(`ENTIDAD_RES`, .keep_all = TRUE) %>% arrange(`ENTIDAD_RES`) %>% drop_na() # #Numero de pruebas por estado según el día # pruebasxEstadoxDia <- pruebasfiltro %>% # group_by(`ENTIDAD_RES`,`FECHA_INGRESO`) %>% # mutate(count=n()) %>% # distinct(`ENTIDAD_RES`, .keep_all = TRUE) %>% # arrange(`ENTIDAD_RES`) %>% # drop_na() # # # prubeasXEstadotsbl <- pruebasxEstadoxDia %>% # as_tsibble( key = `ENTIDAD_RES`, # index = `FECHA_INGRESO` # ) # group_split(pruebasxEstadoxDia) # group_keys(pruebasxEstadoxDia) #Positivos por estado totales hasta la fecha de datos positivoxEstado <- confirmados %>% group_by(`ENTIDAD_RES`) %>% mutate(CONFIRMADOS=n()) %>% distinct(`ENTIDAD_RES`, .keep_all = TRUE) %>% arrange(`ENTIDAD_RES`) %>% dplyr::select(ENTIDAD_RES, ENTIDAD_FEDERATIVA, CONFIRMADOS ) # #Positivos por estado según el día # positivoxEstadoxDia <- confirmados %>% # group_by(`ENTIDAD_RES`, `FECHA_INGRESO`) %>% # mutate(count=n()) %>% # distinct(`ENTIDAD_RES`, .keep_all = TRUE) %>% # arrange(`ENTIDAD_RES`) %>% # drop_na() # # positivoXDiatsbl <- positivoxEstadoxDia %>% # as_tsibble( key = ENTIDAD_RES, # index = FECHA_INGRESO # # ) #Selección de nombre estados, por orden de codigo nombreEstado <- Entidades %>% dplyr::select(`ENTIDAD_FEDERATIVA`) %>% slice( 1:32) # Agrupación de datos totales ----------------------------------------------------- # #suma total de las pruebas realizadas totalpruebas <- pruebasXEstado$PRUEBAS %>% sum(na.rm = TRUE) #suma total de las pruebas que salieron positivas totalpositivas <- positivoxEstado$CONFIRMADOS %>% sum(na.rm = TRUE) #Porcentaje por estado de las pruebas positivas a el total de pruebas realizadas en los estados positividadPais <- (totalpositivas/totalpruebas)*100 #positividadPais positividad <- ((positivoxEstado$CONFIRMADOS/pruebasXEstado$PRUEBAS)*100) #positividad #porcentaje total de las pruebas positivas de acuerdo a que estado. porcenestado <- (positivoxEstado$CONFIRMADOS/totalpositivas)*100 porcenestado <- as.numeric(porcenestado) #porcenestado #Porcentaje total de pruebas positvas porcen <- sum(positividad, na.rm = TRUE) #verificación de suma de porcentaje de pruebas positivas (porcenestado) sumporcentaje <- sum(porcenestado, na.rm = TRUE) # creamos tibble con datos de codigo de entidad y casos positivos nueva <- positivoxEstado %>% #agregamos porcentajes de acuerdo al total de pruebas positivas add_column(porcenestado)%>% #agregamos porcentajes del total de pruebas add_column(positividad) %>% add_column(pruebasXEstado$PRUEBAS) # #Agregamos el nombre de los estados por orden de codigo # add_column(nombreEstado) # Agrupación de datos 2020 ------------------------------------------------ # #suma total de las pruebas realizadas # totalpruebas2020 <- pruebEstado2020$count %>% # sum(na.rm = TRUE) #suma total de las pruebas que salieron positivas totalpositivas2020 <- confirmEstado2020$count %>% sum(na.rm = TRUE) #Porcentaje por estado de las pruebas positivas a el total de pruebas realizadas en los estados positividad2020 <- (confirmEstado2020$count/pruebEstado2020$count)*100 #positividad2020 #porcentaje total de las pruebas positivas de acuerdo a que estado. porcenestado2020 <- (confirmEstado2020$count/totalpositivas2020)*100 porcenestado2020 <- as.numeric(porcenestado) #porcenestado2020 #Porcentaje total de pruebas positvas porcen2020 <- sum(positividad2020, na.rm = TRUE) #verificación de suma de porcentaje de pruebas positivas (porcenestado) sumporcentaje2020 <- sum(porcenestado2020, na.rm = TRUE) # creamos tibble con datos de codigo de entidad y casos positivos nueva2020 <- confirmEstado2020 %>% #agregamos porcentajes de acuerdo al total de pruebas positivas add_column(porcenestado2020)%>% #agregamos porcentajes del total de pruebas add_column(positividad2020) %>% #Agregamos el nombre de los estados por orden de codigo add_column(nombreEstado) # Agrupación de datos 2021 ------------------------------------------------ # #suma total de las pruebas realizadas # totalpruebas2021 <- pruebEstado2021$count %>% # sum(na.rm = TRUE) #suma total de las pruebas que salieron positivas totalpositivas2021 <- confirmEstado2021$count %>% sum(na.rm = TRUE) #Porcentaje por estado de las pruebas positivas a el total de pruebas realizadas en los estados positividad2021 <- (confirmEstado2021$count/pruebEstado2021$count)*100 #positividad2021 #porcentaje total de las pruebas positivas de acuerdo a que estado. porcenestado2021 <- (confirmEstado2021$count/totalpositivas2021)*100 porcenestado2021 <- as.numeric(porcenestado2021) #porcenestado2021 #Porcentaje total de pruebas positvas porcen2021 <- sum(positividad2021, na.rm = TRUE) #verificación de suma de porcentaje de pruebas positivas (porcenestado) sumporcentaje2021 <- sum(porcenestado2021, na.rm = TRUE) # creamos tibble con datos de codigo de entidad y casos positivos nueva2021 <- confirmEstado2021 %>% #agregamos porcentajes de acuerdo al total de pruebas positivas add_column(porcenestado2021)%>% #agregamos porcentajes del total de pruebas add_column(positividad2021) %>% #Agregamos el nombre de los estados por orden de codigo add_column(nombreEstado) # Mapa de positividad total -------------------------------------------------------------------- # de acuerdo al número de pruebas realizadas se calcula el porcentaje de las #pruebas que fueron seleccionadas como positivas. (por estado) #data(nueva) nueva$value <- nueva$positividad nueva$region <- nueva$ENTIDAD_RES # mxstate_choropleth(nueva, # num_colors = 1, # title = "Porcentaje de casos positivos", # legend = "%", # ) #Mapa interactivo bins = c(15, 18, 21, 24, 27, 30, 33, 36, 39, 42, 45, 48, 51, 54, 57, 60, 63, 66, 69, 72) pal <- colorBin("viridis", domain = nueva$value, bins=bins) mxstate_leaflet(nueva, pal, ~ pal(value), ~ sprintf("Estado: %s
Porcentaje de positividad : %s", ENTIDAD_FEDERATIVA , comma(value) )) %>% addLegend(position = "bottomright", pal = pal, values = nueva$value, title = "Percentaje
Positividad", labFormat = labelFormat(suffix = "%", )) %>% addTiles() %>% addMarkers(50, 50) %>% addControl("Mapa positividad de las pruebas totales", position = "bottomleft") %>% addProviderTiles("CartoDB.Positron") ``` Row ------------------------------------ ### Porcentaje 2020 ```{r} # Mapa 2020 --------------------------------------------------------------- # de acuerdo al número de pruebas realizadas se calcula el porcentaje de las #pruebas que fueron seleccionadas como positivas. (por estado del año 2020) data(nueva2020) nueva2020$value <- nueva2020$positividad2020 nueva2020$region <- nueva2020$ENTIDAD_RES # mxstate_choropleth(nueva, # num_colors = 1, # title = "Porcentaje de casos positivos", # legend = "%", # ) #Mapa interactivo bins=c(15, 18, 21, 24, 27, 30, 33, 36, 39, 42, 45, 48, 51, 54, 57, 60, 63, 66, 69, 72) pal <- colorBin("viridis", domain = nueva2020$value, bins=bins) mxstate_leaflet(nueva2020, pal, ~ pal(value), ~ sprintf("Estado: %s
Porcentaje de positividad : %s", ENTIDAD_FEDERATIVA , comma(value) )) %>% addLegend(position = "bottomright", pal = pal, values = nueva2020$value, title = "Percentaje
Positividad", labFormat = labelFormat(suffix = "%", )) %>% addTiles() %>% addMarkers(50, 50) %>% addControl("Mapa positividad de las pruebas en 2020", position = "bottomleft") %>% addProviderTiles("CartoDB.Positron") ``` ### Porcentaje 2021 ```{r} # Mapa 2021 --------------------------------------------------------------- # de acuerdo al número de pruebas realizadas se calcula el porcentaje de las #pruebas que fueron seleccionadas como positivas. (por estado del año 2021) data(nueva2021) nueva2021$value <- nueva2021$positividad2021 nueva2021$region <- nueva2021$ENTIDAD_RES # mxstate_choropleth(nueva2021, # num_colors = 1, # title = "Porcentaje de casos positivos", # legend = "%", # ) #Mapa interactivo bins = c(15, 18, 21, 24, 27, 30, 33, 36, 39, 42, 45, 48, 51, 54, 57, 60, 63, 66, 69, 72) pal <- colorBin("viridis", domain = nueva2021$value, bins=bins) mxstate_leaflet(nueva2021, pal, ~ pal(value), ~ sprintf("Estado: %s
Porcentaje de positividad : %s", ENTIDAD_FEDERATIVA , comma(value) )) %>% addLegend(position = "bottomright", pal = pal, values = nueva2021$value, title = "Percentaje
Positividad", labFormat = labelFormat(suffix = "%", )) %>% addTiles() %>% addMarkers(50, 50) %>% addControl("Mapa positividad de pruebas en 2021", position = "bottomleft") %>% addProviderTiles("CartoDB.Positron") ``` ```{r} # Carga de datos ---------------------------------------------------------- #Se importan los datos como un tibble Vacunastotales <- readr::read_csv("https://raw.githubusercontent.com/owid/covid-19-data/master/public/data/vaccinations/vaccinations.csv") # Wrangle data ------------------------------------------------------------ #Se quiere trabajar con series de tiempo, entonces convertimos # a tsibble un objeto que tiene orientación a este tiempo de #procesamiento Vacunastotales_tsibble <- Vacunastotales %>% dplyr::mutate(Daily = as.Date(date)) %>% dplyr::select(-date) %>% tsibble::as_tsibble(key = location, index = Daily) #se hace una variable con los nombres de los paises de #LATAM para asi poder llamar la variable a buscar en #la base de datos si se requiere, esto esta pensado #en que la instrucción podría hacerse varias veces #entonces en teoría debería simplificar el código latam <- c("Mexico", "Argentina", "Colombia", "Chile", "Brazil", "Bolivia", "Costa Rica", "Ecuador", "Guatemala", "Panama", "Paraguay", "Peru", "Puerto Rico", "Dominican Republic") #Se encontro que era particularmente complicado mostrar #todos los datos en una sola gráfica, por lo tanto, #graficar por secciones y pegar con patchwork es una #opción viable, por lo que la variable length(latam) = 14 #entonces dividimos en 2 grupos para tener símetria. latam1 <- latam[1:7] latam2 <- latam[8:14] #latam == latam1 + latam2 #hacemos otro dafa frame que solo sea para los de #LATAM y asi trabajamos con un tsibble más pequeña Vacunas_latam_tsibble <- Vacunastotales_tsibble %>% dplyr::select( Daily, location, total_vaccinations, total_vaccinations_per_hundred, daily_vaccinations_per_million) %>% filter(location %in% latam) ``` Vacunación en LATAM ========================================= Row ------------------------------------ ### Escenario general ```{r} #Gráfica que representa el escenario general para los paises #de latam en el tiempo vacunados por cada 100 EscenarioLatam <- ggplot(data = Vacunas_latam_tsibble) + geom_line(mapping = aes(x = Daily, y = total_vaccinations_per_hundred, color = location)) + labs(x = 'meses', y = 'Vacunas aplicadas por cada 100') plotly::ggplotly(EscenarioLatam) #Notas de el gráifco EscenarioLatam #muestra una tendencia creciente #con temporalidad variable #No hay evidencia de comportmaiento ciclico ``` ### Temporalidad (Mensual) ```{r} # #Visualización por periocidad ------------------------------------------- #Utilizando la función gg_season para hacer graficas #de la vacunación (2 gráficas por pais correspondiente a los # 2 años de los que se tienen datos) por mes. Vacunas_latam_tsibble %>% filter(location %in% latam1) %>% gg_season(total_vaccinations_per_hundred, labels = "both") + labs(y = "Vacunas aplicadas por cada 100", x = "Meses", title = "Vacunación por meses en los diferentes paises de LATAM") + expand_limits(x = ymd(c("2021-02","2021-04"))) -> g1 #se repite el codigo para hacer lo mismo y luego juntarlos #con el apoyo de patch work Vacunas_latam_tsibble %>% filter(location %in% latam2) %>% gg_season(total_vaccinations_per_hundred, labels = "both") + labs(y = "Vacunas aplicadas por cada 100", x = "Meses", title = "Vacunación por meses en los diferentes paises de LATAM") + expand_limits(x = ymd(c("2021-02","2021-04"))) -> g2 #No se estiliza que la asignación vaya hasta el final #pues transgrede con el estilo del código, pero se recomienda #en el libro de forescasting para darle "fluidez" a la lectura #del código #Se encuentra interesante que en marzo la mayoría de los paises #tienen una linea constante #Méxio y chile empezaron la vacunación en las últimas semanas #de diciembre # Visualización: Integración de los gráficos con PATCHWORK ----------------------------- #Establecemos un layout, que es basicamente un # para los espacios en blanco, y letras #para los lugares que deseamos que ocupe la letra layout <- ' AAAABBBB AAAABBBB AAAABBBB ' #cambiamos el lugar de las letras en el layout por nuestrras gráficas wrap_plots(A = g1, B = g2, design = layout) ``` ### Temporalidad (semanal por mes) ```{r} #Aquí vemos las gráficas anteriores más a detalle, pues podemos #ver en que semanas de cada mes hay crecimiento Vacunas_latam_tsibble %>% filter(location %in% latam1) %>% gg_season(total_vaccinations_per_hundred, period = "month") + labs(y = "Vacunas aplicadas por cada 100", x = "Periodicidad de las semanas del mes", title = " Vacunación por semanana de los diferentes meses en los paises de LATAM") + expand_limits(x = ymd(c("2021-02","2021-04"))) -> g3 #repetimos el código para la sección 2 Vacunas_latam_tsibble %>% filter(location %in% latam2) %>% gg_season(total_vaccinations_per_hundred, period = "month") + labs(y = "Vacunas aplicadas por cada 100", x = "Periodicidad de las semanas del mes", title = " Vacunación por semanana de los diferentes meses en los paises de LATAM") + expand_limits(x = ymd(c("2021-02","2021-04"))) -> g4 # Visualización: Integración de los gráficos con PATCHWORK ----------------------------- #Establecemos un layout, que es basicamente un # para los espacios en blanco, y letras #para los lugares que deseamos que ocupe la letra layout <- ' AAAABBBB AAAABBBB AAAABBBB ' #cambiamos el lugar de las letras en el layout por nuestrras gráficas wrap_plots(A = g3, B = g4, design = layout) ``` Row ------------------------------------ ### Pronósticos ```{r} # Definición del modelo --------------------------------------------------- #TSLM(total_vaccinations_per_hundred ~ trend()) # Entrenamiento del modelo (Estimación) ----------------------------------- fit <- Vacunas_latam_tsibble %>% model(Modelo_tendencia = TSLM(total_vaccinations_per_hundred ~ trend())) #fit # Revisar el desempeño del modelo (evaluación) ---------------------------- # Producir pronósticos ---------------------------------------------------- #Se genera la tabla de pronósticos, el cual va ser #una tabla de tipo fable (objeto) es decir #forecasting table fcst <- fit %>% forecast(h = 3) #se hace para los siguientes 3 meses #pues los datos que se tienen hasta el momento # son de 4 - 5 meses #fcst # Visualización de la forecasting table #para grupo 1 latama fcst %>% filter(location %in% latam1) %>% autoplot(Vacunas_latam_tsibble) + ggtitle('Vacunas en LATAM') + ylab('Vacunas aplicadas por cada 100') + xlab('Mes') -> fcst1 #para grupo 2 latam fcst %>% filter(location %in% latam2) %>% autoplot(Vacunas_latam_tsibble) + ggtitle('Vacunas en LATAM') + ylab('Vacunas aplicadas por cada 100') + xlab('Mes') -> fcst2 #integración de las visualizaciones fcst3 = fcst1 + fcst2 fcst3 ```